﻿Public Class Kendoku
    Inherits Puzzle

    Public Sub New()
        AvailableSizes = Range(4, 9)
        Size = 5
        SupportsRegioning = True
    End Sub

    Public Overrides Function OnKeyPress(ByVal Key As String) As Boolean
        If CursorCell.Region = "." Then Return MyBase.OnKeyPress(Key)
        Dim R = Regions(CursorCell.Region)
        Select Case Key
            Case "0" To "9", "+", "-", "*", "/", "x"
                R.Hint = Trim(R.Hint) & Key
            Case "back"
                R.Hint = Trim(Val(R.Hint.ExcludeLast(1)))
                If R.Hint = "0" Then R.Hint = ""
            Case "delete"
                R.Hint = ""
            Case Else
                Return MyBase.OnKeyPress(Key)
        End Select
    End Function

    Public Overrides Sub Load(ByVal Data As String)
        Dim Items = Data.Split("|")
        Size = Math.Sqrt(Items.Length)
        NewPuzzle()
        For i As Integer = 0 To Size * Size - 1
            Dim Cell As Cell = Cells(i)
            Dim d = Items(i).Split(";")
            Cell.g = d(0)
            Cell.Region = d(1)
        Next
        SetRegions()
        Invalidate()
    End Sub

    Public Overrides Function Save() As String
        Return ""
    End Function

    Public Overrides Sub NewPuzzle()
        MyBase.NewPuzzle()
        For Each Item In Cells
            Dim Cell = Item
            Cell.Groups.Add((From g In Groups Where g.Type = 1 And g.Index = Cell.x).First)
            Cell.Groups.Add((From g In Groups Where g.Type = 2 And g.Index = Cell.y).First)
        Next
    End Sub

    Public Overrides Sub Solve()
        For Each Cell In Cells
            Cell.Reset(Mid("123456789", 1, Size))
        Next
        For Each Group In Groups
            Group.Reset()
        Next
        For Each rg In Regions.Where(Function(r) r.Cells.Count = 1)
            rg.Cells.First.SetValue(rg.Hint)
        Next
        Dim Level As Integer = 1
        Do
            Dim Progress As Boolean = False
            Select Case Level
                Case 1 : Progress = ProcessCellHints(2)
                Case 2 : Progress = NakedCandidates()
                Case 3 : Progress = SingleCandidates()
                Case 4 : Progress = ProcessCellHints(3)
                Case 5 : Progress = RegionNakedPairs()
                Case 6 : Progress = NakedPairs()
                Case 7 : Progress = HiddenPairs()
                Case 8 : Progress = XWing()
                Case 9 : Progress = ProcessCellHints(4)
                Case 10 : Progress = ProcessRegionPairs()
                Case 11 : Progress = ProcessCellHints(5)
                Case 12 : Progress = ProcessCellHints(6)
                Case 13 : Progress = ProcessCellHints(7)
                Case Else : If Not Progress Then Exit Do
            End Select
            Level = IIf(Progress, 1, Level + 1)
            FlushLog()
            If (From c As Cell In Cells Where c.f = "" Select c).Count = 0 Then Exit Do
        Loop
        Invalidate()
    End Sub

    Function RegionNakedPairs() As Boolean
        Dim Progress As Boolean = False
        For Each res In (
                From r In Regions Where r.Cells.Count = 3
                From i In Range(0, 2) Let c1 = r.Cells(i), c2 = r.Cells((i + 1) Mod 3), c3 = r.Cells((i + 2) Mod 3) Where c1.Candidates.Count > 1
                Where c2.Candidates.Count = 2 And c2.CandidateStr = c3.CandidateStr And ((c2.y = c3.y) Or (c2.x = c3.x))
                Let cnd2 = c2.Candidates(0), cnd3 = c2.Candidates(1)
                From cnd1 In c1.Candidates Where Not Test(r.Hint, Val(cnd1) & "," & Val(cnd2) & "," & Val(cnd3))).ToList
            Progress = True
            res.c1.Eliminate(res.cnd1)
        Next
        Return Progress
    End Function

    Function ProcessCellHints(ByVal count As Integer) As Boolean
        Dim Progress As Boolean = False
        For Each res In (
                From r In Regions Where r.Cells.Count = count
                From i In Range(0, count - 1) Let Cell = r.Cells(i) Where Cell.Candidates.Count > 1 Let gc = (From j In Range(1, count - 1) Select r.Cells((i + j) Mod count)).ToList
                From cnd1 In Cell.Candidates.Union(Cell.f) Where Not (From prm In Permutations(gc) Where Test(r.Hint, Val(cnd1) & "," & prm)).Any).ToList
            Progress = True
            res.Cell.Eliminate(res.cnd1)
        Next
        Return Progress
    End Function

    Function Permutations(ByVal Cells As List(Of Cell)) As List(Of String)
        Return If(Cells.Count = 1, (From cnd In Cells(0).Candidates.Union(Cells(0).f) Select cnd & "").ToList, (From cnd In Cells(0).Candidates.Union(Cells(0).f) From p In Permutations((From c In Cells Where Not c Is Cells(0)).ToList) Select cnd & "," & p).ToList)
    End Function

    Function Test(ByVal Hint As String, ByVal List As String) As Boolean
        Dim Op = Right(Hint, 1)
        Dim Value = Hint.Substring(0, Hint.Length - 1)
        Dim Args = List.Split(",")
        Select Case Op
            Case "+" : Return Args.Aggregate(0, Function(x, y) x + y) = Value
            Case "x", "*" : Return Args.Aggregate(1, Function(x, y) x * y) = Value
            Case "-" : Return Math.Abs(Args(0) - Args(1)) = Value
            Case "/" : Return If(Args(0) > Args(1), Args(0) / Args(1), Args(1) / Args(0)) = Value
        End Select
    End Function

    Function ProcessRegionPairs()
        Dim Progress = False
        Dim Poss = From r In Regions Where r.Cells.Count = 2 AndAlso r.Cells(0).f = ""
                   Where Not (r.Cells(0).Candidates.Count = 2 And r.Cells(0).CandidateStr = r.Cells(1).CandidateStr)
                   Let PossibleChars = r.Cells(0).Candidates.Union(r.Cells(1).Candidates)
                   From c In PossibleChars Where Not (
                   From prm In Permutations(r.Cells) Where Test(r.Hint, prm)
                   Where Not prm.Replace(",", "").Contains(c)).Any
                   From g In Groups Where g.Cells.Contains(r.Cells(0)) And g.Cells.Contains(r.Cells(1))
                   From cnd In g.Cells Where Not r.Cells.Contains(cnd) AndAlso cnd(c)
        For Each P In Poss
            Progress = True
            P.cnd.Eliminate(P.c)
        Next
        Return False
    End Function

End Class
